perm filename FNDTRN.BAD[NEW,LCS] blob sn#312596 filedate 1977-10-26 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
C00016 ENDMK
CāŠ—;
	SUBROUTINE FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
	DIMENSION PGTRN(1),JBAR(1),IBAR(1)
	COMMON /BRJ/JTOT,TURN,NB,DSK
	PGTRN(KT)=100
C LAST BAR ALWAYS GOOD FOR TURN (FOR AUTOMATIC SYSTEM)
	IBAR(1)=0
	IF(TURN.EQ.0)TURN=2
C WANTS HALF  REST FOR TURN AT FIRST
	RPG=JTOT/250.+.5
	LPG=RPG
	LT=1
11	AV=JTOT/RPG
	AV2=2*AV
	NTOT=JTOT
	KB=1
	NAV=5.*AV/2.
C  FOR MINIMUM LINES PER PAGE
	MM=1
	SPG=RPG
7	JAV=AV*5.
	J=0
	DO 1 K=LT,KT
	J=J+JBAR(K)
1	IF(J.GE.JAV)GO TO 2
C JUMP OUT WHEN JPAGE IS IDEALLY FULL
2	L=-1
C  FOR FLIPFLOP
	N=K
	M=K
	NN=J
	JJ=J
3	IF(PGTRN(K).GE.TURN)GO TO 4
C JUMP IF TURN FOUND
	IF(J.GE.NAV)GO TO 10
CHECK TO SEE IF TOO SMALL A PAGE
	TURN=TURN-.5
CUT DOWN REST SIZE AND TRY AGAIN.
	GO TO 11
10	L=-L
C FLIPFLOP
	IF(L)GO TO 5
C NEXT BACKS UP
	N=N-1
	NN=NN-JBAR(N)
	J=NN
	K=N
	GO TO 3
5	M=M+1
C MOVES AHEAD TO FIND RESTS
	JJ=JJ+JBAR(M)
	J=JJ
	K=M
	GO TO 3
4	KB=KB+1
	IBAR(KB)=K
	KB=KB+1
	IBAR(KB)=100*MM
	MM=2
C  FIRST PAGE IS A SINGLE, DOUBLES AFTERWARD
	NTOT=NTOT-J
CUT DOWN TOTAL SIZE TO LOOK AT
	IF(NTOT.LE.250)GO TO 9
C  250 IS JLINE(IDEAL SIZE OF A LINE)
	RPG=NTOT/250.+.5
	LPG=RPG
	AV=(NTOT/LPG)*2.
	LT=K+1
	GO TO 7
9	IBAR(1)=5
C 5 IS ARBITRARY NUM OF LINES/PAGE FOR NOW
	KB=KB+1
	TYPE 12,TURN
12	FORMAT(' TURN TIME UNIT =',F4.2)
	END

	SUBROUTINE BRJUGL(JBAR,KT,NBAR,MBAR,JRN,PGTRN,JTRN)
	COMMON /BRJ/JTOT,TRN,NB,DSK /MNX/MIN,MAX,JT /Q/Q(1)
	COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,NO1,LPG,MPG,CLEF,SIG,NO2,SPG,MTR1,MTR2 
	DIMENSION JBAR(1),NBAR(1),MBAR(1),JRN(1),PGTRN(1),JTRN(1)
	NT=JT
	L=1
	TOT=JTOT
	AV=TOT/JT 
	ITOT=0
	SUM=0
	A=0    
	NBAR(1)=1
	J=0
 	M=1
	K=JBAR(J)
4	SUM=SUM+AV
1	J=J+1
	IF(J.GT.KT)GO TO 2
	B=JBAR(J)
	C=A+B
	IF(C.GT.SUM)GO TO 5
3	A=C
	GO TO 1
5	IF(C-SUM.LE.B/2)GO TO 3
	L=L+1
	NBAR(L)=J+1
	GO TO 4
2	NBAR(L+1)=0

CX515	CALL GET(NBAR,JBAR,MBAR,JRN)
	JAV=JTOT/JT
	CALL MINMAX(JBAR)
308	FORMAT(' AVG=',I3,'  MIN=',I3,'  MAX=',I3)
	TYPE 308,JAV,MIN,MAX
	IF(DSK)WRITE(21,308)JAV,MIN,MAX
307	DO 310 K=1,NBAR(JT+1)-1
	L=JBAR(K)
	IF(PGTRN(K).GE.TRN)L=-L
310	JTRN(K)=L
C ABOVE MAKES NEG. BAR VALUES WHERE TURNS ARE POSSIBLE.
	
	LJ=0
306	FORMAT(I5,'  (',I3,')',3X50I5)
309	DO 305 K=1,JT
	LJ=LJ+1
	NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
	L=NBAR(K)-1+J
	MM=NB+J-1
	M=0
	DO 6 N=J,L
6	M=M+JBAR(N)
	TYPE 306,M,MM,(JTRN(N),N=J,L)
	IF(DSK)WRITE(21,306)M,MM,(JTRN(N),N=J,L)
	IF(LJ.LT.MPG)GO TO 305
	LJ=0
	IF(DSK)WRITE(21,3066)
	TYPE 3066
3066	FORMAT(' ************')
305	J=L+1
	NBAR(JT+1)=0
	END

	SUBROUTINE GET(NBAR,JBAR,MBAR,JRN)
	COMMON  /MNX/MIN,MAX,JT
	DIMENSION MBAR(1),JBAR(1),JRN(1),NBAR(1)
	J=1
	DO 1 K=2,JT+1
	NBAR(K)=MBAR(K)
	N=0
	DO 2 L=J,MBAR(K)-1
C FIX UP JRN ARRAY
2	N=N+JBAR(L)
	JRN(K-1)=N
1	J=MBAR(K)
	END

CC	SUBROUTINE MNMX(IDIF,JRN)
CC	COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
CC	L=MIN
CC	N=MAX
CC	CALL MINMAX(JRN)
CC	J=MAX-MIN
CC	IF(J.LE.IDIF)GO TO 1
CC	MIN=L
CC	MAX=N
CC	RETURN
CC1	IDIF=J
CC	END
***** Arrow at Line 12 of 543 ***** Page 2 of 2 ***** 18R +366C *****